home *** CD-ROM | disk | FTP | other *** search
/ Visual Basic Source Code / Visual Basic Source Code.iso / vbsource / acciap1g / custom~1.bas next >
Encoding:
BASIC Source File  |  1999-08-01  |  9.1 KB  |  265 lines
  1. Attribute VB_Name = "ShowOpen"
  2. Option Explicit
  3.  
  4. Enum CmdCaption 'Enum for getting the caption
  5.     Cmd_Cancel = 2
  6.     Cmd_Open = 9
  7.     Cap_Open_Window = 130
  8.     Tab_New = 200
  9.     Tab_Open = 201
  10.     Tab_Recent = 205
  11.     LstItm_Name = 30034
  12.     LstItm_File = 30124
  13. End Enum
  14.  
  15. Public BorderX As Long 'Some variables needed
  16. Public BorderY As Long
  17. Public TitleBarHeight As Long
  18. Public TempCaption As String
  19. Public Use_Filters As String
  20. Public Use_InitDir As String
  21. Public Use_Caption As String
  22. Public DialogRetData As String
  23.  
  24. Private Declare Function GetOpenFileName Lib "comdlg32.dll" Alias "GetOpenFileNameA" (pOpenfilename As OpenFileName) As Long
  25. Private Declare Function GetWindowTextLength Lib "user32" Alias "GetWindowTextLengthA" (ByVal hwnd As Long) As Long
  26. Private Declare Function GetWindowText Lib "user32" Alias "GetWindowTextA" (ByVal hwnd As Long, ByVal lpString As String, ByVal cch As Long) As Long
  27. Private Declare Function GetSystemMetrics Lib "user32" (ByVal nIndex As Long) As Long
  28.  
  29. Declare Function SetWindowText Lib "user32" Alias "SetWindowTextA" (ByVal hwnd As Long, ByVal lpString As String) As Long
  30. Declare Function SetActiveWindow Lib "user32" (ByVal hwnd As Long) As Long
  31. Declare Function FindWindow Lib "user32" Alias "FindWindowA" (ByVal lpClassName As String, ByVal lpWindowName As String) As Long
  32. Declare Function SetParent Lib "user32" (ByVal HwndChild As Long, ByVal hWndNewParent As Long) As Long
  33. Declare Function SetWindowPos Lib "user32" (ByVal hwnd As Long, ByVal hWndInsertAfter As Long, ByVal x As Long, ByVal y As Long, ByVal cx As Long, ByVal cy As Long, ByVal wFlags As Long) As Long
  34. Declare Function GetWindowRect Lib "user32" (ByVal hwnd As Long, lpRect As RECT) As Long
  35.  
  36. Type RECT
  37.         Left As Long
  38.         Top As Long
  39.         Right As Long
  40.         Bottom As Long
  41. End Type
  42.      
  43. Public Type OpenFileName
  44.     lStructSize As Long
  45.     hwndOwner As Long
  46.     hInstance As Long
  47.     lpstrFilter As String
  48.     lpstrCustomFilter As String
  49.     nMaxCustFilter As Long
  50.     nFilterIndex As Long
  51.     lpstrFile As String
  52.     nMaxFile As Long
  53.     lpstrFileTitle As String
  54.     nMaxFileTitle As Long
  55.     lpstrInitialDir As String
  56.     lpstrTitle As String
  57.     Flags As Long
  58.     nFileOffset As Integer
  59.     nFileExtension As Integer
  60.     lpstrDefExt As String
  61.     lCustData As Long
  62.     lpfnHook As Long
  63.     lpTemplateName As String
  64. End Type
  65.  
  66.     Public Const OFN_READONLY = &H1
  67.     Public Const OFN_OVERWRITEPROMPT = &H2
  68.     Public Const OFN_HIDEREADONLY = &H4
  69.     Public Const OFN_NOCHANGEDIR = &H8
  70.     Public Const OFN_SHOWHELP = &H10
  71.     Public Const OFN_ENABLEHOOK = &H20
  72.     Public Const OFN_ENABLETEMPLATE = &H40
  73.     Public Const OFN_ENABLETEMPLATEHANDLE = &H80
  74.     Public Const OFN_NOVALIDATE = &H100
  75.     Public Const OFN_ALLOWMULTISELECT = &H200
  76.     Public Const OFN_EXTENSIONDIFFERENT = &H400
  77.     Public Const OFN_PATHMUSTEXIST = &H800
  78.     Public Const OFN_FILEMUSTEXIST = &H1000
  79.     Public Const OFN_CREATEPROMPT = &H2000
  80.     Public Const OFN_SHAREAWARE = &H4000
  81.     Public Const OFN_NOREADONLYRETURN = &H8000
  82.     Public Const OFN_NOTESTFILECREATE = &H10000
  83.     Public Const OFN_NONETWORKBUTTON = &H20000
  84.     Public Const OFN_NOLONGNAMES = &H40000 ' force no long names for 4.x modules
  85.     Public Const OFN_EXPLORER = &H80000 ' new look commdlg
  86.     Public Const OFN_NODEREFERENCELINKS = &H100000
  87.     Public Const OFN_SHAREFALLTHROUGH = 2
  88.     Public Const OFN_SHARENOWARN = 1
  89.     Public Const OFN_SHAREWARN = 0
  90.     
  91.     Const RegKey = "HKEY_CURRENT_USER\Software\Your Company\Your App\Your Version\RecentFiles" 'Rescent files key
  92. Function OpenDialog(hwnd As Long, Title As String) As String
  93.         
  94.     Dim ofn As OpenFileName
  95.     Dim Ret As Long
  96.     
  97.     ofn.lStructSize = Len(ofn) 'Settings of the dialog
  98.     ofn.hwndOwner = hwnd
  99.     ofn.hInstance = App.hInstance
  100.     ofn.lpstrFilter = Use_Filters
  101.     ofn.lpstrFile = Space$(254)
  102.     ofn.nMaxFile = 255
  103.     ofn.lpstrFileTitle = Space$(254)
  104.     ofn.nMaxFileTitle = 255
  105.     ofn.lpstrInitialDir = Use_InitDir
  106.     ofn.lpstrTitle = Title
  107.     ofn.Flags = OFN_HIDEREADONLY Or OFN_FILEMUSTEXIST
  108.     
  109.     Ret = GetOpenFileName(ofn) ''Draw the open window
  110.     
  111.     If (Ret) Then
  112.         OpenDialog = Trim$(ofn.lpstrFile)
  113.     Else
  114.         OpenDialog = ""
  115.     End If
  116.     
  117.     
  118. End Function
  119. Function GetTitleBarHeight()
  120. '
  121. ' Get the TitlebarHeight
  122. '
  123. BorderX = GetSystemMetrics(7)
  124. BorderY = GetSystemMetrics(8)
  125. TitleBarHeight = 2 * GetSystemMetrics(5) + GetSystemMetrics(4)
  126. End Function
  127. Public Function GetWindowTitle(ByVal hwnd As Long) As String
  128. '
  129. ' You can image what this is...
  130. '
  131.    Dim l As Long
  132.    Dim s As String
  133.    
  134.    l = GetWindowTextLength(hwnd)
  135.    s = Space(l + 1)
  136.    
  137.    GetWindowText hwnd, s, l + 1
  138.    
  139.    GetWindowTitle = Left$(s, l)
  140. End Function
  141. Private Sub GenerateRandomCaption()
  142. TempCaption = vbNullString
  143. Dim i As Long
  144. For i = 0 To 40 'Make a random caption: !! DO NOT INCLUDE CHR(0) !! This will couse to crash VB
  145.     TempCaption = TempCaption & Chr(Int((Rnd() * 23) + 60))
  146. Next
  147. TempCaption = "Open (" & TempCaption & ")"
  148. End Sub
  149. '************************************************************************************************
  150. '
  151. 'ShowExtendedOpenDialog(SourceForm as Form, Filter as String, Title as String, InitDir as String)
  152. '
  153. 'Parameters:
  154. '
  155. ' SourceForm, Thisform will be disabled while running
  156. ' Filter, File type Filter ie.(All Files|*.*|New Files|*.NEW|); If empty default is used
  157. ' Title, The Opendialogs caption; If empty default is used
  158. ' Initdir, The Active Directory; If empty curent is used
  159. '
  160. ' Don't forget to change the "RegKey" so it can find the recent files in the registry!
  161. '
  162. '************************************************************************************************
  163. Public Function ShowExtendedOpenDialog(SourceForm As Form, Filter As String, Title As String, InitDir As String) As String
  164.  
  165.     Dim A As Long
  166.  
  167.     SourceForm.Enabled = False 'Let's start
  168.     
  169.     GenerateRandomCaption 'Make an random caption
  170.     GetTitleBarHeight 'Calculates the height of the caption bar from registry.
  171.     
  172.     If Filter = vbNullString Then 'if empty then set default
  173.         Filter = "All Files|*.*|"
  174.     End If
  175.  
  176.     If Title = vbNullString Then 'if empty then set default
  177.         Title = GetCaption(Cap_Open_Window)
  178.     End If
  179.  
  180.     'Formats the filter
  181.     If Right$(Filter, 1) = "|" Then Filter = Filter + "|"
  182.     For A = 1 To Len(Filter)
  183.         If Mid$(Filter, A, 1) = "|" Then Mid$(Filter, A, 1) = Chr$(0)
  184.     Next
  185.             
  186.     'Put Variabels into memmory
  187.     Use_Filters = Filter
  188.     Use_InitDir = InitDir
  189.     Use_Caption = Title
  190.     
  191.     On Error Resume Next 'Shometimes next gives strange errors while unloading
  192.     FrmOpen.Show 1
  193.     
  194.     ShowExtendedOpenDialog = DialogRetData 'Function data set
  195.     
  196.     SourceForm.Enabled = True 'Ok, we are ready
  197.  
  198. End Function
  199. Sub Main()
  200. '
  201. ' Example use of function
  202. '
  203. Dim Retval As String
  204.  
  205. MsgBox "This is a litte start of getting a open-file dialog into your interface." & Chr(10) & "It shure is not the right way, but i don't know to do it different... So if you know, please tell me!" & Chr(10) & Chr(10) & "Buggs: (Known)" & Chr(10) & "- User keyboard imput does not work correct." & Chr(10) & "- Screen flashes a little" & Chr(10) & Chr(10) & "Help wanted:" & Chr(10) & "- Getting the EXACT location en caption(Language depended) of the open en close button." & Chr(10) & "- The keyboard problem fix" & Chr(10) & Chr(10) & "You are free to use this code when you display my name (and what I made) in the aboutbox of your application." & Chr(10) & Chr(10) & "Please email your updates to 'Y2KFIXX@HOTMAIL.COM'", vbInformation
  206.  
  207. Retval = ShowExtendedOpenDialog(Form1, "All Files|*.*|", "", "C:\")
  208.  
  209. If Retval = vbNullString Then
  210.     MsgBox "User pressed cancel", vbInformation
  211. ElseIf Left(Retval, 2) = "::" Then ''Use the double dot for templates!, this file can not exist
  212.     MsgBox "User choose an Example " & Retval, vbInformation
  213. Else
  214.     MsgBox "User choose the file: " & Retval, vbInformation
  215. End If
  216. Unload Form1
  217. End Sub
  218. Function GetRescentFiles(Filename As String, Caption As String, Index As Integer) As Long
  219.  
  220. Dim i As Long
  221. Dim TmpString As String
  222.  
  223. If Index = 0 Then
  224.     Do
  225.         i = i + 1
  226.     Loop Until GetStringValue(RegKey, "Filename" & i) = vbNullString
  227.     GetRescentFiles = i - 1
  228. Else
  229.     TmpString = GetStringValue(RegKey, "FileName" & Index)
  230.     Caption = Left(TmpString, InStr(TmpString, ",") - 1)
  231.     Filename = Right(TmpString, Len(TmpString) - InStr(TmpString, ","))
  232. End If
  233. End Function
  234. Function FileExist(FilePathName As String) As Boolean
  235. On Error Resume Next
  236.  
  237. If Dir(FilePathName) = vbNullString Then Err.Raise 1
  238.  
  239. If Err Then
  240.     FileExist = False
  241. Else
  242.     FileExist = True
  243. End If
  244. End Function
  245. Function GetCaption(Item As CmdCaption) As String
  246. Select Case Item
  247.     Case 2
  248.         GetCaption = "Cancel"
  249.     Case 9
  250.         GetCaption = "&Open"
  251.     Case 130
  252.         GetCaption = "Open"
  253.     Case 200
  254.         GetCaption = "&New"
  255.     Case 201
  256.         GetCaption = "&Open"
  257.     Case 205
  258.         GetCaption = "&Recent"
  259.     Case 30034
  260.         GetCaption = "Name"
  261.     Case 30124
  262.         GetCaption = "Filename"
  263. End Select
  264. End Function
  265.